home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / T U R B O Language / Turbo Pascal V7.0 / DOCDEMO.ZIP / TUTOR02C.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-30  |  3KB  |  83 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Tutor02;
  9.  
  10. uses App, Objects, Menus, Drivers, Views, TutConst;
  11.  
  12. type
  13.   TTutorApp = object(TApplication)
  14.     procedure InitMenuBar; virtual;
  15.     procedure InitStatusLine; virtual;
  16.   end;
  17.  
  18. procedure TTutorApp.InitMenuBar;
  19. var
  20.   R: TRect;
  21. begin
  22.   GetExtent(R);
  23.   R.B.Y := R.A.Y + 1;
  24.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  25.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  26.       StdFileMenuItems(nil)),
  27.     NewSubMenu('~E~dit', hcNoContext, NewMenu(
  28.       StdEditMenuItems(
  29.       NewLine(
  30.       NewItem('~S~how clipboard', '', kbNoKey, cmClipShow, hcNoContext,
  31.       nil)))),
  32.     NewSubMenu('~O~rders', hcNoContext, NewMenu(
  33.       NewItem('~N~ew', 'F9', kbF9, cmOrderNew, hcNoContext,
  34.       NewItem('~S~ave', '', kbNoKey, cmOrderSave, hcNoContext,
  35.       NewLine(
  36.       NewItem('Next', 'PgDn', kbPgDn, cmOrderNext, hcNoContext,
  37.       NewItem('Prev', 'PgUp', kbPgUp, cmOrderPrev, hcNoContext,
  38.       nil)))))),
  39.     NewSubMenu('O~p~tions', hcNoContext, NewMenu(
  40.       NewItem('~T~oggle video', '', kbNoKey, cmOptionsVideo, hcNoContext,
  41.       NewItem('~S~ave desktop', '', kbNoKey, cmOptionsSave, hcNoContext,
  42.       NewItem('~L~oad desktop', '', kbNoKey, cmOptionsLoad, hcNoContext,
  43.       nil)))),
  44.     NewSubMenu('~W~indow', hcNoContext, NewMenu(
  45.       NewItem('Orders', '', kbNoKey, cmOrderWin, hcNoContext,
  46.       NewItem('Stock items', '', kbNoKey, cmStockWin, hcNoContext,
  47.       NewItem('Suppliers', '', kbNoKey, cmSupplierWin, hcNoContext,
  48.       NewLine(
  49.       StdWindowMenuItems(nil)))))),
  50.     NewSubMenu('~H~elp', hcNoContext, NewMenu(
  51.       NewItem('~A~bout...', '', kbNoKey, cmAbout, hcNoContext,
  52.       nil)),
  53.     nil))))))
  54.   )));
  55. end;
  56.  
  57. procedure TTutorApp.InitStatusLine;
  58. var
  59.   R: TRect;
  60. begin
  61.   GetExtent(R);
  62.   R.A.Y := R.B.Y - 1;
  63.   New(StatusLine, Init(R,
  64.     NewStatusDef(0, $EFFF,
  65.       NewStatusKey('~F3~ Open', kbF3, cmOpen,
  66.       NewStatusKey('~F4~ New', kbF4, cmNew,
  67.       NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose,
  68.       StdStatusKeys(nil)))),
  69.     NewStatusDef($F000, $FFFF,
  70.       NewStatusKey('~F6~ Next', kbF6, cmOrderNext,
  71.       NewStatusKey('~Shift+F6~ Prev', kbShiftF6, cmOrderPrev,
  72.       StdStatusKeys(nil))), nil))));
  73. end;
  74.  
  75. var
  76.   TutorApp: TTutorApp;
  77.  
  78. begin
  79.   TutorApp.Init;
  80.   TutorApp.Run;
  81.   TutorApp.Done;
  82. end.
  83.